home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / hui-window.el < prev    next >
Encoding:
Text File  |  1995-06-03  |  25.6 KB  |  653 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         hui-window.el
  4. ;; SUMMARY:      Smart Mouse Key window and modeline depress/release actions.
  5. ;; USAGE:        GNU Emacs Lisp Library, Load only when mouse is available.
  6. ;; KEYWORDS:     hypermedia, mouse
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola, Inc., PWDG
  10. ;;
  11. ;; ORIG-DATE:    21-Sep-92
  12. ;; LAST-MOD:      2-Jun-95 at 11:29:41 by Bob Weiner
  13. ;;
  14. ;; This file is part of Hyperbole.
  15. ;; Available for use and distribution under the same terms as GNU Emacs.
  16. ;;
  17. ;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
  18. ;; Developed with support from Motorola Inc.
  19. ;;
  20. ;; DESCRIPTION:  
  21. ;;
  22. ;;   Must be loaded AFTER hmouse-alist has been defined in
  23. ;;   "hui-mouse.el".
  24. ;;
  25. ;;   Handles drags in same window or across windows and modeline depresses.
  26. ;;
  27. ;; What drags and modeline presses do.
  28. ;; ==============================================================================
  29. ;;                                              Smart Keys
  30. ;; Context                         Action Key                 Assist Key
  31. ;; ==============================================================================
  32. ;; Drag horizontally within window
  33. ;;     Left to right               Scroll to buffer end       Split window across
  34. ;;     Right to left               Scroll to buffer begin     Delete window
  35. ;; Click in modeline
  36. ;;     Left window edge            Bury buffer                Unbury bottom buffer
  37. ;;     Right window edge           Info                       Smart Key Summary
  38. ;;     Otherwise                   Action Key Hook            Assist Key Hook
  39. ;; Modeline depress & wind release Resize window height       <- same
  40. ;; Drag from shared window side    Resize window's width      <- same
  41. ;; Drag from one window to another Create/modify a link but   Swap buffers
  42. ;; Drag vertically within window   Split window sideways      <- same
  43. ;; Drag diagonally within window   Save ring frame-config     Restore ring config
  44. ;;
  45. ;; DESCRIP-END.
  46.  
  47. ;;; ************************************************************************
  48. ;;; Public variables
  49. ;;; ************************************************************************
  50.  
  51. (defvar action-key-modeline-hook 'hmouse-context-menu
  52.   "A list of functions to call when the Action Mouse Key is clicked in the center portion of a modeline.")
  53.  
  54. (defvar assist-key-modeline-hook nil
  55.   "A list of functions to call when the Assist Mouse Key is clicked in the center portion of a modeline.")
  56.  
  57. (defvar hmouse-edge-sensitivity 3
  58.   "*Number of characters from window edges within which a click is considered at an edge.")
  59.  
  60. (defvar hmouse-side-sensitivity (if hyperb:emacs19-p 2 1)
  61.   "*Characters in either direction from window side within which a click is considered on the side.")
  62.  
  63. (defvar hmouse-x-drag-sensitivity 5
  64.   "*Number of chars mouse must move horizontally between depress/release to register a horizontal drag.")
  65.  
  66. (defvar hmouse-y-drag-sensitivity 3
  67.   "*Number of lines mouse must move vertically between depress/release to register a vertical drag.")
  68.  
  69. (defvar hmouse-x-diagonal-sensitivity 4
  70.   "*Number of chars mouse must move horizontally between depress/release to register a diagonal drag.")
  71. (defvar hmouse-y-diagonal-sensitivity 3
  72.   "*Number of lines mouse must move vertically between depress/release to register a diagonal drag.")
  73.  
  74. ;;;
  75. ;;; Add mode line handling to hmouse-alist dispatch table.
  76. ;;;
  77. (if (not (boundp 'hmouse-alist))
  78.     (error
  79.       "\"hui-modeln.el\": hmouse-alist must be defined before loading this.")
  80.   (or (memq 'hmouse-drag-window-side
  81.         (mapcar (function (lambda (elt) (let ((pred (car elt)))
  82.                           (if (listp pred) (car pred)))))
  83.             hmouse-alist))
  84.       (setq hmouse-alist
  85.         (append
  86.           '(
  87.         ((hmouse-drag-window-side) .
  88.          ((hmouse-resize-window-side) .
  89.           (hmouse-resize-window-side 'assist)))
  90.         ((setq hkey-value 
  91.                (and (not (hmouse-drag-between-windows))
  92.                 (hmouse-drag-horizontally))) .
  93.          ((hmouse-horizontal) . (hmouse-horizontal-assist)))
  94.         ((hmouse-modeline-depress) .
  95.          ((action-key-modeline) . (assist-key-modeline)))
  96.         ((hmouse-drag-between-windows) .
  97.          ((hui:link-directly) . (hmouse-swap-buffers 'assist)))
  98.         ((hmouse-drag-vertically) .
  99.          ((sm-split-window-horizontally) .
  100.           (sm-split-window-horizontally)))
  101.         ((setq hkey-value (hmouse-drag-diagonally)) .
  102.          ((wconfig-ring-save) .
  103.           (wconfig-yank-pop
  104.             (prefix-numeric-value current-prefix-arg))))
  105.         )
  106.           hmouse-alist))))
  107.  
  108.  
  109. ;;; ************************************************************************
  110. ;;; Public functions
  111. ;;; ************************************************************************
  112.  
  113. (defun hmouse-drag-between-windows ()
  114.   "Returns non-nil if last Action Key depress and release were in different windows.
  115. If free variable 'assist-flag' is non-nil, uses Assist Key."
  116.   (if assist-flag
  117.       (and assist-key-depress-window assist-key-release-window
  118.        (not (eq assist-key-depress-window
  119.             assist-key-release-window)))
  120.     (and action-key-depress-window action-key-release-window
  121.      (not (eq action-key-depress-window action-key-release-window)))))
  122.  
  123. (defun hmouse-drag-diagonally ()
  124.   "Returns non-nil iff last Action Key use was a diagonal drag within a single window.
  125. If free variable 'assist-flag' is non-nil, uses Assist Key.
  126. Value returned is nil if not a diagonal drag, or one of the following symbols
  127. depending on the direction of the drag: southeast, southwest, northwest, northeast."
  128.   (let ((last-depress-x) (last-release-x)
  129.     (last-depress-y) (last-release-y))
  130.     (if assist-flag
  131.     (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
  132.           last-release-x (hmouse-x-coord assist-key-release-args)
  133.           last-depress-y (hmouse-y-coord assist-key-depress-args)
  134.           last-release-y (hmouse-y-coord assist-key-release-args))
  135.       (setq last-depress-x (hmouse-x-coord action-key-depress-args)
  136.         last-release-x (hmouse-x-coord action-key-release-args)
  137.         last-depress-y (hmouse-y-coord action-key-depress-args)
  138.         last-release-y (hmouse-y-coord action-key-release-args)))
  139.     (and last-depress-x last-release-x last-depress-y last-release-y
  140.      (>= (- (max last-depress-x last-release-x)
  141.         (min last-depress-x last-release-x))
  142.          hmouse-x-diagonal-sensitivity)
  143.      (>= (- (max last-depress-y last-release-y)
  144.         (min last-depress-y last-release-y))
  145.          hmouse-y-diagonal-sensitivity)
  146.      (cond
  147.        ((< last-depress-x last-release-x)
  148.         (if (< last-depress-y last-release-y)
  149.         'southeast 'northeast))
  150.        (t (if (< last-depress-y last-release-y)
  151.           'southwest 'northwest))))))
  152.  
  153. (defun hmouse-drag-horizontally ()
  154.   "Returns non-nil iff last Action Key use was a horizontal drag within a single window.
  155. If free variable 'assist-flag' is non-nil, uses Assist Key.
  156. Value returned is nil if not a horizontal drag, 'left if drag moved left or
  157. 'right otherwise."
  158.   (let ((last-depress-x) (last-release-x)
  159.     (last-depress-y) (last-release-y))
  160.     (if assist-flag
  161.     (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
  162.           last-release-x (hmouse-x-coord assist-key-release-args)
  163.           last-depress-y (hmouse-y-coord assist-key-depress-args)
  164.           last-release-y (hmouse-y-coord assist-key-release-args))
  165.       (setq last-depress-x (hmouse-x-coord action-key-depress-args)
  166.         last-release-x (hmouse-x-coord action-key-release-args)
  167.         last-depress-y (hmouse-y-coord action-key-depress-args)
  168.         last-release-y (hmouse-y-coord action-key-release-args)))
  169.     (and last-depress-x last-release-x last-depress-y last-release-y
  170.      (>= (- (max last-depress-x last-release-x)
  171.         (min last-depress-x last-release-x))
  172.          hmouse-x-drag-sensitivity)
  173.      ;; Don't want to register vertical drags here, so ensure any
  174.      ;; vertical movement was less than the vertical drag sensitivity.
  175.      (< (- (max last-depress-y last-release-y)
  176.            (min last-depress-y last-release-y))
  177.         hmouse-y-drag-sensitivity)
  178.      (if (< last-depress-x last-release-x) 'right 'left))))
  179.  
  180. (defun hmouse-drag-vertically ()
  181.   "Returns non-nil iff last Action Key use was a vertical drag within a single window.
  182. If free variable 'assist-flag' is non-nil, uses Assist Key.
  183. Value returned is nil if not a vertical line drag, 'up if drag moved up or
  184. 'down otherwise."
  185.   (let ((last-depress-x) (last-release-x)
  186.     (last-depress-y) (last-release-y))
  187.     (if assist-flag
  188.     (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
  189.           last-release-x (hmouse-x-coord assist-key-release-args)
  190.           last-depress-y (hmouse-y-coord assist-key-depress-args)
  191.           last-release-y (hmouse-y-coord assist-key-release-args))
  192.       (setq last-depress-x (hmouse-x-coord action-key-depress-args)
  193.         last-release-x (hmouse-x-coord action-key-release-args)
  194.         last-depress-y (hmouse-y-coord action-key-depress-args)
  195.         last-release-y (hmouse-y-coord action-key-release-args)))
  196.     (and last-depress-x last-release-x last-depress-y last-release-y
  197.      (>= (- (max last-depress-y last-release-y)
  198.         (min last-depress-y last-release-y))
  199.          hmouse-y-drag-sensitivity)
  200.      ;; Don't want to register horizontal drags here, so ensure any
  201.      ;; horizontal movement was less than or equal to the horizontal drag
  202.      ;; sensitivity.
  203.      (<= (- (max last-depress-x last-release-x)
  204.         (min last-depress-x last-release-x))
  205.          hmouse-x-drag-sensitivity)
  206.      (if (< last-depress-y last-release-y) 'down 'up))))
  207.  
  208. (or (fboundp 'abs)
  209.     (defun abs (number)
  210.       "Return the absolute value of NUMBER."
  211.       (cond
  212.     ((< number 0)
  213.      (- 0 number))
  214.     (t number))))
  215.  
  216. (defun hmouse-drag-window-side ()
  217.   "Returns non-nil if Action Key was dragged from a window side divider.
  218. If free variable 'assist-flag' is non-nil, uses Assist Key."
  219.   (cond (hyperb:xemacs-p
  220.      ;; Depress events in scrollbars or in non-text area of buffer are
  221.      ;; not visible or identifiable at the Lisp-level, so always return
  222.      ;; nil.
  223.      nil)
  224.     (hyperb:window-system
  225.      (let* ((depress-args (if assist-flag assist-key-depress-args
  226.                 action-key-depress-args))
  227.         (release-args (if assist-flag assist-key-release-args
  228.                 action-key-release-args))
  229.         (w (smart-window-of-coords depress-args))
  230.         (side-ln (and w (1- (nth 2 (window-edges w)))))
  231.         (last-press-x   (hmouse-x-coord depress-args))
  232.         (last-release-x (hmouse-x-coord release-args)))
  233.        (and last-press-x last-release-x side-ln
  234.         (/= last-press-x last-release-x)
  235.         (/= (1+ side-ln) (frame-width))
  236.         (<= (max (- last-press-x side-ln) (- side-ln last-press-x))
  237.             hmouse-side-sensitivity))))))
  238.  
  239. (defun sm-split-window-horizontally ()
  240.   "Splits current window in two evenly, side by side.
  241. Beeps and prints message if can't split window further."
  242.   (interactive)
  243.   (let ((window-min-width 5))
  244.     (condition-case ()
  245.     (split-window-horizontally nil)
  246.       (error (progn (beep)
  247.             (message
  248.              "(sm-split-window-horizontally): Can't split window further."))))))
  249.  
  250. (defun sm-split-window-vertically ()
  251.   "Splits current window in two evenly, one above the other.
  252. Beeps and prints message if can't split window further."
  253.   (interactive)
  254.   (let ((window-min-height 2))
  255.     (condition-case ()
  256.     (if (fboundp 'split-window-quietly)
  257.         (split-window-quietly nil)
  258.       (split-window-vertically nil))
  259.       (error
  260.     (progn
  261.       (beep)
  262.       (message
  263.         "(sm-split-window-vertically): Can't split window further."))))))
  264.  
  265. (defun smart-coords-in-window-p (coords window)
  266.   "Tests if COORDS are in WINDOW.  Returns WINDOW if they are, nil otherwise."
  267.   (cond ((and hyperb:emacs19-p (eventp coords))
  268.      (eq (posn-window (event-start coords)) window))
  269.     ((if hyperb:xemacs-p
  270.          (if (eventp coords)
  271.          (eq (event-window coords) window)
  272.            (eq (car coords) window))))
  273.     ((fboundp 'window-edges)
  274.      (let* ((edges (window-edges window))
  275.           (w-xmin (nth 0 edges))
  276.           (w-ymin (nth 1 edges))
  277.           (w-xmax (nth 2 edges))
  278.           (w-ymax (nth 3 edges))
  279.           (x  (hmouse-x-coord coords))
  280.           (y  (hmouse-y-coord coords)))
  281.          (and (<= w-xmin x) (<= x w-xmax)
  282.           (<= w-ymin y) (<= y w-ymax)
  283.           window)))))
  284.  
  285. (defun smart-window-of-coords (coords)
  286.   "Returns window in which COORDS fall or nil if none.
  287. Ignores minibuffer window."
  288.   (cond ((and hyperb:emacs19-p (eventp coords))
  289.      (posn-window (event-start coords)))
  290.     ((if hyperb:xemacs-p
  291.          (if (eventp coords)
  292.          (event-window coords)
  293.            (car coords))))
  294.     (t (let ((window-list (hypb:window-list 'no-minibuf))
  295.          (window)
  296.          (w))
  297.          (while (and (not window) window-list)
  298.            (setq w (car window-list)
  299.              window-list (cdr window-list)
  300.              window (smart-coords-in-window-p coords w)))
  301.          window))))
  302.  
  303. ;;; ************************************************************************
  304. ;;; Private functions
  305. ;;; ************************************************************************
  306.  
  307. (defun hmouse-context-menu ()
  308.   "If running under a window system, display or hide the buffer menu.
  309. If not running under a window system and Smart Menus are loaded, display the
  310. appropriate Smart Menu for the context at point."
  311.   (if (and (fboundp 'smart-menu)
  312.        (or (null window-system)
  313.            (not (or hyperb:lemacs-p hyperb:emacs19-p))))
  314.       (smart-menu)
  315.     (let ((wind (get-buffer-window "*Buffer List*"))
  316.       owind)
  317.       (if wind
  318.       (unwind-protect
  319.           (progn (setq owind (selected-window))
  320.              (select-window wind)
  321.              (bury-buffer nil))
  322.         (select-window owind))
  323.     (buffer-menu nil)))))
  324.  
  325. (defun hmouse-horizontal ()
  326.   "Goes to buffer end if drag was to the right, otherwise goes to beginning."
  327.   (if (eq hkey-value 'right)
  328.       (end-of-buffer)
  329.     (beginning-of-buffer)))
  330.  
  331. (defun hmouse-horizontal-assist ()
  332.   "Splits window vertically if drag was to the right, otherwise deletes window."
  333.   (if (eq hkey-value 'right)
  334.       (sm-split-window-vertically)
  335.     (delete-window)))
  336.  
  337. (defun action-key-modeline ()
  338.   "Handles Action Key depresses on a window mode line.
  339. If key is:
  340.  (1) clicked on left edge of a window's modeline,
  341.      window's buffer is buried (placed at bottom of buffer list);
  342.  (2) clicked on right edge of a window's modeline,
  343.      the Info buffer is displayed, or if already displayed and the
  344.      modeline clicked belongs to a window displaying Info, the Info
  345.      buffer is hidden;
  346.  (3) clicked anywhere in the middle of a window's modeline,
  347.      the functions listed in 'action-key-modeline-hook' are called;
  348.  (4) dragged vertically from modeline to within a window,
  349.      the modeline is moved to point of key release, thereby resizing
  350.      its window and potentially its vertical neighbors."
  351.   (let ((w (smart-window-of-coords action-key-depress-args)))
  352.     (if w (select-window w))
  353.     (cond ((hmouse-modeline-click)
  354.        (cond ((hmouse-release-left-edge)  (bury-buffer))
  355.          ((hmouse-release-right-edge)
  356.           (if (eq major-mode 'Info-mode)
  357.               (Info-exit)
  358.             (info)))
  359.          (t (run-hooks 'action-key-modeline-hook))))
  360.       (t (hmouse-modeline-resize-window)))))
  361.  
  362. (defun assist-key-modeline ()
  363.   "Handles Assist Key depresses on a window mode line.
  364. If secondary key is:
  365.  (1) clicked on left edge of a window's modeline,
  366.      bottom buffer in buffer list is unburied and placed in window;
  367.  (2) clicked on right edge of a window's modeline,
  368.      the summary of Smart Key behavior is displayed, or if already
  369.      displayed and the modeline clicked belongs to a window displaying
  370.      the summary, the summary buffer is hidden;
  371.  (3) clicked anywhere in the middle of a window's modeline,
  372.      the functions listed in 'assist-key-modeline-hook' are called;
  373.  (4) dragged vertically from modeline to within a window,
  374.      the modeline is moved to point of key release, thereby resizing
  375.      its window and potentially its vertical neighbors."
  376.   (let ((val)
  377.     (w (smart-window-of-coords assist-key-depress-args)))
  378.     (if w (select-window w))
  379.     (cond ((hmouse-modeline-click 'assist)
  380.        (cond ((hmouse-release-left-edge 'assist)
  381.           (let* ((bufs (buffer-list))
  382.              (entry (1- (length bufs))))
  383.             (while (not (setq val (nth entry bufs)
  384.                       val (and (/= (aref (buffer-name val) 0)
  385.                            ? )
  386.                            val)))
  387.               (setq entry (1- entry)))
  388.             (switch-to-buffer val)))
  389.          ((hmouse-release-right-edge 'assist)
  390.           (if (equal (buffer-name) (hypb:help-buf-name "Smart"))
  391.               (hkey-help-hide)
  392.             (hkey-summarize 'current-window)))
  393.          (t (run-hooks 'assist-key-modeline-hook))))
  394.       (t (hmouse-modeline-resize-window 'assist)))))
  395.  
  396. (defun hmouse-modeline-click (&optional assist-flag)
  397.   "Returns non-nil if last Action Key depress and release was at same point in a modeline.
  398. Optional ASSIST-FLAG non-nil means test for Assist Key click instead."
  399.   ;; Assume depress was in modeline and that any drag has already been handled.
  400.   ;; So just check that release was in modeline.
  401.   (hmouse-modeline-release assist-flag))
  402.  
  403. (defun hmouse-modeline-depress ()
  404.   "Returns non-nil if Action Key was depressed on a window mode line.
  405. If free variable 'assist-flag' is non-nil, uses Assist Key."
  406.   (let ((args (if assist-flag assist-key-depress-args
  407.         action-key-depress-args)))
  408.     (if (and hyperb:window-system args)
  409.     (if (fboundp 'event-over-modeline-p)
  410.         (event-over-modeline-p args)
  411.       (let* ((w (smart-window-of-coords args))
  412.          (mode-ln (and w (1- (nth 3 (window-edges w)))))
  413.          (last-press-y (hmouse-y-coord args)))
  414.         (and last-press-y mode-ln (= last-press-y mode-ln)))))))
  415.  
  416. (defun hmouse-modeline-release (&optional assist-flag)
  417.   "Returns non-nil if Action Key was released on a window mode line.
  418. Optional non-nil ASSIST-FLAG means test release of Assist Key instead."
  419.   (let ((args (if assist-flag assist-key-release-args
  420.         action-key-release-args)))
  421.     (if (and hyperb:window-system args)
  422.     (if (fboundp 'event-over-modeline-p)
  423.         (event-over-modeline-p args)
  424.       (let* ((w (smart-window-of-coords args))
  425.          (mode-ln (and w (1- (nth 3 (window-edges w)))))
  426.          (last-press-y (hmouse-y-coord args)))
  427.         (and last-press-y mode-ln (= last-press-y mode-ln)))))))
  428.  
  429. (defun hmouse-modeline-resize-window (&optional assist-flag)
  430.   "Resizes window whose mode line was depressed upon by the Action Key.
  431. Resize amount depends upon the vertical difference between press and release
  432. of the Action Key.  Optional arg ASSIST-FLAG non-nil means use values from
  433. Assist Key instead."
  434.   (cond ((not hyperb:window-system) nil)
  435.     ((and hyperb:xemacs-p (not (fboundp 'window-edges)))
  436.      (error "Drag from a mode-line with button1 to resize windows."))
  437.     (t (let* ((owind (selected-window))
  438.           (window (smart-window-of-coords
  439.                (if assist-flag assist-key-depress-args
  440.                  action-key-depress-args)))
  441.           (mode-ln (and window (1- (nth 3 (window-edges window)))))
  442.           (last-release-y
  443.            (hmouse-y-coord
  444.             (if assist-flag assist-key-release-args
  445.               action-key-release-args)))
  446.           (shrink-amount (- mode-ln last-release-y)))
  447.          ;; Restore position of point prior to Action Key release.
  448.          (if action-key-release-prev-point
  449.          (let ((obuf (current-buffer)))
  450.            (unwind-protect
  451.                (progn
  452.              (set-buffer
  453.               (marker-buffer action-key-release-prev-point))
  454.              (goto-char
  455.               (marker-position action-key-release-prev-point)))
  456.              (set-buffer obuf))))
  457.          (cond
  458.           ((>= (+ mode-ln 2) (frame-height))
  459.            (error
  460.         "(hmouse-modeline-resize-window): Can't move bottom window in frame."))
  461.           ((< (length (hypb:window-list 'no-minibuf)) 2)
  462.            (error
  463.         "(hmouse-modeline-resize-window): Can't resize sole window in frame."))
  464.           (t (unwind-protect
  465.              (progn
  466.                (select-window window)
  467.                (shrink-window shrink-amount)
  468.                ;; Keep redisplay from scrolling other window.
  469.                (select-window (next-window nil 'no-mini))
  470.                (condition-case ()
  471.                (scroll-down shrink-amount)
  472.              (error nil)))
  473.            (select-window owind))))))))
  474.  
  475. (defun hmouse-release-left-edge (&optional assist-flag)
  476.   "Returns non-nil if last Action Key release was at left window edge.
  477. 'hmouse-edge-sensitivity' value determines how near to actual edge the
  478. release must be."
  479.   (let ((args (if assist-flag assist-key-release-args
  480.          action-key-release-args))
  481.     window-left last-release-x)
  482.     (if (fboundp 'window-lowest-p) ;; XEmacs >= 19.12 
  483.     (setq last-release-x (and args (eq (event-window args)
  484.                        (selected-window))
  485.                   (hmouse-x-coord args))
  486.           window-left 0)
  487.       (setq window-left (car (window-edges))
  488.         last-release-x (and args (hmouse-x-coord args))))
  489.     (and last-release-x (< (- last-release-x window-left)
  490.                hmouse-edge-sensitivity)
  491.      (>= (- last-release-x window-left) 0))))
  492.  
  493. (defun hmouse-release-right-edge (&optional assist-flag)
  494.   "Returns non-nil if last Action Key release was at right window edge.
  495. 'hmouse-edge-sensitivity' value determines how near to actual edge the
  496. release must be."
  497.   (let ((args (if assist-flag assist-key-release-args
  498.          action-key-release-args))
  499.     window-right last-release-x)
  500.     (if (fboundp 'window-lowest-p) ;; XEmacs >= 19.12 
  501.     (setq last-release-x (and args (eq (event-window args)
  502.                        (selected-window))
  503.                   (hmouse-x-coord args))
  504.           window-right (window-width))
  505.       (setq window-right (nth 2 (window-edges))
  506.         last-release-x (and args (hmouse-x-coord args))))
  507.     (and last-release-x (>= (+ last-release-x hmouse-edge-sensitivity)
  508.                 window-right)
  509.      (>= (- window-right last-release-x) 0))))
  510.  
  511. (defun hmouse-resize-window-side (&optional assist-flag)
  512.   "Resizes window whose side was depressed upon by the Action Key.
  513. Resize amount depends upon the horizontal difference between press and release
  514. of the Action Key.  Optional arg ASSIST-FLAG non-nil means use values from
  515. Assist Key instead."
  516.   (cond (hyperb:xemacs-p
  517.      ;; Depress events in scrollbars or in non-text area of buffer are
  518.      ;; not visible or identifiable at the Lisp-level, so always return
  519.      ;; nil.
  520.      nil)
  521.     (hyperb:window-system
  522.      (let* ((owind (selected-window))
  523.         (window (smart-window-of-coords
  524.              (if assist-flag assist-key-depress-args
  525.                action-key-depress-args)))
  526.         (side-ln (and window (1- (nth 2 (window-edges window)))))
  527.         (last-release-x
  528.          (hmouse-x-coord
  529.           (if assist-flag assist-key-release-args
  530.             action-key-release-args)))
  531.         (shrink-amount (- side-ln last-release-x))
  532.         )
  533.        ;; Restore position of point prior to Action Key release.
  534.        (if action-key-release-prev-point
  535.            (let ((obuf (current-buffer)))
  536.          (unwind-protect
  537.              (progn
  538.                (set-buffer (marker-buffer action-key-release-prev-point))
  539.                (goto-char (marker-position action-key-release-prev-point)))
  540.            (set-buffer obuf))))
  541.        (cond
  542.         ((>= (+ side-ln 2) (frame-width))
  543.          (error
  544.           "(hmouse-resize-window-side): Can't change width of full frame width window."))
  545.         ((< (length (hypb:window-list 'no-minibuf)) 2)
  546.          (error
  547.           "(hmouse-resize-window-side): Can't resize sole window in frame."))
  548.         (t (unwind-protect
  549.            (progn
  550.              (select-window window)
  551.              (shrink-window-horizontally shrink-amount))
  552.          (select-window owind))))))))
  553.  
  554. (defun hmouse-swap-buffers (&optional assist-flag)
  555.   "Swaps buffers in windows selected with last Action Key depress and release.
  556. If optional arg ASSIST-FLAG is non-nil, uses Assist Key."
  557.   (let* ((w1 (if assist-flag assist-key-depress-window
  558.            action-key-depress-window))
  559.      (w2 (if assist-flag assist-key-release-window
  560.            action-key-release-window))
  561.      (w1-buf (and w1 (window-buffer w1)))
  562.      (w2-buf (and w2 (window-buffer w2)))
  563.      )
  564.     (or (and w1 w2)
  565.     (error "(hmouse-swap-buffers): Last depress or release not within a window."))
  566.     ;; Swap window buffers.
  567.     (set-window-buffer w1 w2-buf)
  568.     (set-window-buffer w2 w1-buf)))
  569.  
  570. (defun hmouse-swap-windows (&optional assist-flag)
  571.   "Swaps windows selected with last Action Key depress and release.
  572. If optional arg ASSIST-FLAG is non-nil, uses Assist Key."
  573.   (let* ((w1 (if assist-flag assist-key-depress-window
  574.            action-key-depress-window))
  575.      (w2 (if assist-flag assist-key-release-window
  576.            action-key-release-window))
  577.      (w1-width  (and w1 (window-width w1)))
  578.      (w1-height (and w1 (window-height w1)))
  579.      (w2-width  (and w2 (window-width w2)))
  580.      (w2-height (and w2 (window-height w2)))
  581.      )
  582.     (or (and w1 w2)
  583.     (error "(hmouse-swap-windows): Last depress or release not within a window."))
  584.     (unwind-protect
  585.     (progn
  586.       (select-window w1)
  587.       (if (not (= w1-height (frame-height)))
  588.           (shrink-window (- w1-height w2-height)))
  589.       (if (not (= w1-width (frame-width)))
  590.           (shrink-window-horizontally (- w1-width w2-width)))
  591.       (select-window w2)
  592.       (setq w2-width (window-width w2)
  593.         w2-height (window-height w2))
  594.       (if (not (= w2-height (frame-height)))
  595.           (shrink-window (- w2-height w1-height)))
  596.       (if (not (= w2-width (frame-width)))
  597.           (shrink-window-horizontally (- w2-width w1-width)))
  598.       )
  599.       (select-window w2)
  600.       )))
  601.  
  602. (defun hmouse-x-coord (args)
  603.   "Returns x coordinate in chars from window system dependent ARGS."
  604.   (let ((x (eval (cdr (assoc hyperb:window-system
  605.                  '(("emacs19" . (if (eventp args)
  606.                         (+ (car (posn-col-row
  607.                              (event-start args)))
  608.                            (nth 0 (window-edges
  609.                                (car
  610.                                 (car (cdr args))
  611.                                 ))))
  612.                           (car args)))
  613.                    ("lemacs" .  (if (eventp args)
  614.                         (event-x args)
  615.                           (car args)))
  616.                    ("xterm"  .  (car args))
  617.                    ("epoch"  .  (nth 0 args))   ;; Epoch V4
  618.                    ("sun"    .  (nth 1 args))
  619.                    ("next"   .  (nth 1 args))
  620.                    ("apollo" .  (car args))
  621.                    ))))))
  622.     (if (integerp x) x (error "(hmouse-x-coord): invalid X coord: %s" x))))
  623.  
  624. (defun hmouse-y-coord (args)
  625.   "Returns y coordinate in frame lines from window system dependent ARGS."
  626.   (let ((y (eval (cdr (assoc hyperb:window-system
  627.                  '(("emacs19" . (if (eventp args)
  628.                         (+ (cdr (posn-col-row
  629.                              (event-start args)))
  630.                            (nth 1 (window-edges
  631.                                (car
  632.                                 (car (cdr args))
  633.                                 ))))
  634.                           (cdr args)))
  635.                    ("lemacs" .  (if (eventp args)
  636.                         (event-y args)
  637.                           (cdr args)))
  638.                    ("xterm"  .  (nth 1 args))
  639.                    ("epoch"  .  (nth 1 args))   ;; Epoch V4
  640.                    ("sun"    .  (nth 2 args))
  641.                    ("next"   .  (nth 2 args))
  642.                    ("apollo" .  (nth 1 args))
  643.                    ))))))
  644.     (if (integerp y) y (error "(hmouse-y-coord): invalid Y coord: %s" y))))
  645.  
  646.  
  647. ;;; ************************************************************************
  648. ;;; Private variables
  649. ;;; ************************************************************************
  650.  
  651.  
  652. (provide 'hui-window)
  653.